home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d6 / payment.arc / PAYMENT.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1985-10-28  |  3.1 KB  |  80 lines

  1. 1000  '"PAYMENT" Calculates payment to amortize a loan
  2. 1010  ' By Robert Hamilton
  3. 1020  PROG1$="         P A Y M E N T         "
  4. 1025  REV$ = "          Rev: 830120          "
  5. 1030  PROG2$="      By Hamilton Company      "
  6. 1040  PROG3$="                               "
  7. 1050  PROG4$="NOTE: This program computes the monthly payment to fully amortize a loan":Q$=CHR$(34)
  8. 1052  SCREEN 0,0,0:WIDTH 80:COLOR 2,0,0:KEY OFF:CLS:UP$=STRING$(1,30)
  9. 1053  LOCATE ,,1,12,13:DEF SEG=0:IF PEEK (&H410)= 109 THEN LOCATE ,,,6,7
  10. 1054  DEF SEG=64:POKE 23,160:DEF SEG:CL$=STRING$(79,0):Q$=CHR$(34)
  11. 1070       REM: DEFDBLDEFDBL KEYS
  12. 1080  FOR I=1 TO 10:ON KEY(I) GOSUB 0:KEY(I) ON:NEXT
  13. 1140  KEY OFF: KEY 1,CHR$(27)+"CLS:LIST "
  14. 1150  KEY 2,CHR$(27)+"RUN  "+CHR$(7):KEY 3,CHR$(27)+"LOAD"+CHR$(7)+CHR$(34)
  15. 1160  KEY 4,CHR$(27)+"SAVE"+CHR$(34):KEY 5,CHR$(27)+"RUN"+CHR$(7)+CHR$(34):KEY 6,CHR$(27)+"GOTO 1000"
  16. 1170  KEY 7,CHR$(27)+"FILES "+CHR$(34)+"a:*.*":KEY 8,CHR$(27)+"RENUM 1000"
  17. 1180  KEY 9,CHR$(12)+"COLOR 6,0:CLS"+CHR$(13):KEY 10,CHR$(27)+"RUN"+CHR$(34)+"AUTOST"
  18. 1190  DEFDBL A:CL$=STRING$(79,0):UP$=STRING$(1,30):ON ERROR GOTO 1400
  19. 1200       REM: DEFDBLDEFDBL TITLE
  20. 1210  CLS:LOCATE 5,25:PRINT CHR$(213)+STRING$(31,205)+CHR$(184)
  21. 1220  PRINT TAB(25);CHR$(179)+STRING$(31,32)+CHR$(179)
  22. 1230  PRINT TAB(25);CHR$(179);:COLOR 6,0:PRINT PROG1$;:COLOR 2,0:PRINT CHR$(179)
  23. 1240  PRINT TAB(25);CHR$(179)+STRING$(31,32)+CHR$(179)
  24. 1250  PRINT TAB(25);CHR$(179);REV$;CHR$(179)
  25. 1260  PRINT TAB(25);CHR$(179)+STRING$(31,32)+CHR$(179)
  26. 1270  PRINT TAB(25);CHR$(212)+STRING$(31,205)+CHR$(190)
  27. 1280  PRINT CHR$(10);TAB(26);PROG2$
  28. 1290  PRINT TAB(26);PROG3$
  29. 1300  COLOR 6,0:LOCATE 20,1:PRINT PROG4$;
  30. 1310  LOCATE 24,1:COLOR 0,7:PRINT" SPACE ";:COLOR 5,0:PRINT" To Continue   ";
  31. 1320  COLOR 0,7:PRINT" Q ";:COLOR 5,0:PRINT" Quit Program ";:COLOR 6,0
  32. 1330  K$=INKEY$:IF MID$(K$,1,1)="Q" OR MID$(K$,1,1)="q" THEN CLS:GOTO 1370
  33. 1340  IF K$="" THEN 1330
  34. 1350  GOTO 1420
  35. 1360     REM DEFSNGDEFSNG EXIT
  36. 1370  'CLS:LOCATE 24,1:color 6,0:PRINT "WAIT - Loading ";Q$;"MENU";Q$;:CHAIN "Autost.bas",1000:END
  37. 1372  CLS:LOCATE 22,1:COLOR 6,0:PRINT "DONE":END
  38. 1380     REM DEFSNGDEFSNG RETURN
  39. 1390  RETURN
  40. 1400     REM DEFSNGDEFSNG ERROR
  41. 1410  CLS:BEEP:LOCATE 21,1:COLOR 12,0:PRINT"ERROR: Correct,  PRESS (F2) and ENTER":COLOR 6,0:ON ERROR GOTO 0:END
  42. 1420     REM DEFSNGDEFSNG START Program
  43. 1430  CLS
  44. 1440  LOCATE 24,1:I2$="1st Yr Interest = $$########,"
  45. 1450  COLOR 6,0:PRINT"NEW LOAN:"
  46. 1460  COLOR 6,0:INPUT"LOAN,    Total Amount ($):  ",P:P2=P
  47. 1470  IF P=0 THEN BEEP:PRINT CHR$(10):GOTO 1650
  48. 1480  IF P<1 OR P>1E+07 THEN BEEP:GOSUB 1760:GOTO 1460
  49. 1490  COLOR 6,0:INPUT;"DURATION or Loan, (Years):  ",N
  50. 1500  IF N=0 THEN BEEP:PRINT CHR$(10):GOTO 1650
  51. 1510  IF N<1 OR N>49 THEN BEEP:GOSUB 1760:GOTO 1490
  52. 1520  N=INT(N*12):PRINT TAB(50);"(";N;"Payments)"
  53. 1530  IF P=0 OR N=0 THEN 1440
  54. 1540  COLOR 6,0:INPUT;"INTEREST Rate, Annual (%):  ",I
  55. 1550  IF I=0 THEN BEEP:PRINT CHR$(10):GOTO 1650
  56. 1560  IF I<1 OR I>99 THEN BEEP:GOSUB 1760:GOTO 1530
  57. 1570  I=I/1200:I2=0
  58. 1580  PMT=P*I*(1+I)^N/((1+I)^N-1):A1=12*PMT
  59. 1590  P$="PAYMENT, Monthly Amount . . . . $$######,.##"
  60. 1600   FOR J=1 TO 12:I2=I2+I*P2:P2=P2-(PMT-I*P2):NEXT
  61. 1610  COLOR 10,0:PRINT TAB(50);:PRINT USING I2$;I2
  62. 1620  P2$="Annual Payments = $$########,."
  63. 1630  PRINT USING P$;PMT;:PRINT TAB(50);
  64. 1640  PRINT USING P2$;A1:PRINT
  65. 1650  LOCATE 25,1:COLOR 0,7:PRINT" I ";:COLOR 5,0:PRINT" For New Interest Rate   ";
  66. 1660  COLOR 0,7:PRINT" L ";:COLOR 5,0:PRINT" For New Loan   ";
  67. 1670  COLOR 0,7:PRINT" B ";:COLOR 5,0:PRINT" Blank Page   ";
  68. 1680  COLOR 0,7:PRINT" Q ";:COLOR 5,0:PRINT" To Quit ";:COLOR 5,0
  69. 1690  K$=INKEY$:IF MID$(K$,1,1)="i"OR MID$(K$,1,1)="I" THEN GOSUB 1750:GOTO 1530
  70. 1700  IF MID$(K$,1,1)="l" OR MID$(K$,1,1)="L" THEN GOSUB 1750:GOTO 1440
  71. 1710  IF MID$(K$,1,1)="b" OR MID$(K$,1,1)="B" THEN GOSUB 1770:GOTO 1650
  72. 1720  IF MID$(K$,1,1)="q" OR MID$(K$,1,1)="Q" THEN 1370
  73. 1730  GOTO 1690
  74. 1740  END
  75. 1750  LOCATE 25,1:PRINT CL$;:LOCATE 24,1:RETURN
  76. 1760  PRINT UP$;CL$;:LOCATE ,1:RETURN
  77. 1770  ON ERROR GOTO 1780:OPEN "LPT1:" FOR OUTPUT AS #1:PRINT #1,CHR$(12);:CLOSE #1:ON ERROR GOTO 1400:RETURN
  78. 1780  CLOSE #1:RESUME 1790
  79. 1790  LOCATE 25,1:PRINT CL$;:LOCATE 25,1:BEEP:COLOR 12,0:PRINT"ERROR: Check Printer - ENTER to Continue";:COLOR 6,0:INPUT;"",ZZ$:LOCATE 25,1:PRINT CL$;:LOCATE 25,1:GOTO 1650
  80.